TITL DAI FIRMWARE DEB8-0E015 V1.1 ORG :DEB8 * * * * =================================== *** BASIC EXECUTION / RUN-TIME MODULE *** * =================================== * * Generally, BC is used as entry pointer to the * textbuffer. * ******************** * RUN basiccmd NEW * ******************** * * Sets up heap, empty textbuffer and symboltable, * sets pointers of textbuffer and symboltable * correctly. Old buffer contents is not destroyed, * (except 4 locations), but not useable. * Valid as direct command only. * * Exit: A=1, CY=1. * RNEW LHLD :029B Get startaddr heap SHLD :029F Set start textbuf=start heap MVI M,:00 Store 00 in 1st addr. INX H SHLD :02A1 Set start symtab MVI M,:00 00 in 1st addr. INX H SHLD :02A3 Set end symtab REM * Entry from scratch/edit: REM HRINIT LHLD :029D Get heap size XCHG in DE CALL :D195 Init heap to all available MVI A,:01 Code for 'buffer crunched' STC RET * ********************* * RUN basiccmd CONT * ********************* * * Resets step flag, decr. CONFL (error if it was * 0), restores FRAME from stack, restores stack- * pointer and continues program execution. * Valid as direct command only. * RCONT XRA A RCN10 STA :0116 Reset step flag LXI H,:0126 Get pntr suspended program DCR M Update it MVI A,:19 JM :D9F5 Evt. run error 'CAN'T CONT' LHLD :0127 Get current base stack level XCHG in DE LXI H,:0015 FRAME length DAD D Top of FRAME in stack PUSH H Save it LXI B,:0100 Addr SYSBOT CALL :DE4F Load FRAME from stack POP H Get addr FRAME top in stack SHLD :0127 Update current base stack REM level SPHL Update stackpointer LHLD :0102 Get start current command MOV B,H MOV C,L Store it in BC JMP :C87F Run BASIC line * ********************* * RUN basiccmd STEP * ********************* * RSTEP MVI A,:FF Init value STEP flag JMP :DED6 Set STEP flag and continu * ********************* * RUN basiccmd STOP * ********************* * * Entry: No conditions. * Exit: A=03, CY=1. HL points after string. * RSTOP CALL :D7E6 Print 'STOPPED' DBL :DBC9 MVI A,:03 Code for 'susp. execution' STC RET * ******************** * RUN basiccmd END * ******************** * * Entry: No conditions. * Exit: A=01, CY=1. HL points after string. * REND CALL :D7E6 Print 'END PROGRAM' DBL :DBCF MVI A,:01 Code for 'stop execution' STC RET * ******************* * RUN basiccmd IF * ******************* * * Used for IF .. GOTO and for * IF .. THEN . * *RIFG RIFTL CALL :E763 (0) Run logical expression INR A JZ :DF63 Run GOTO if condition true REM * If condition false: REM INX B INX B Skip linenr ORA A No special action RET * *************************************** * RUN basiccmd IF .. THEN * *************************************** * RIFTC CALL :E763 (0) Run logical expression INR A JNZ :E18F (0) Ignore rest if false REM * If condition true: REM INX B Skip length line ORA A No special action RET Execute rest of line * ****************** * basiccmd GOSUB * ****************** * * Saves current program state on the interpreter * stack and branches to a named line. The running * FOR loop (if any) is saved in order to avoid * problems if any unpaired NEXT is encountered. * The stackpointer at the subroutine-entry is held * to enable breaking out of a FOR-NEXT loop. * RGOSUB CALL :E6ED (0) Get linenr and find it REM * Entry from ON - GOSUB: REM RGS10 POP D Kill return addr SHLD :0119 Save new PC CALL :E13C (0) Save FOR loop contents PUSH B Save program position LHLD :0119 Get new PC MOV B,H ) Is new text position MOV C,L ) LHLD :0113 Get stack level last GOSUB PUSH H Save evt link to previous REM subroutine entry LXI H,:0000 SHLD :0104 No running loop DAD SP SP in HL SHLD :0113 SP in STKGOS for return REM * Entry on return: REM RGS20 ORA A No special action JMP :C88F Into Basic monitor * *********************** * RUN basiccmd RETURN * *********************** * * Reverses the effect of a previous 'GOSUB'. * RRET POP D Kill returnaddr LHLD :0113 Get stack level last GOSUB MOV A,H ORA L 0 if no active call MVI A,:01 JZ :D9F5 Then run error 'RETURN REM WITHOUT GOSUB' SPHL Else: re-instate old stack POP H SHLD :0113 Link back to previous REM GOSUB POP B Restore text pntr CALL :E167 (0) Pop FRAME JMP :DF48 Back to Basic monitor * ********************* * RUN basiccmd GOTO * ********************* * * Simply transfers control to a named line. * * Entry from IF - GOTO: * RGOTO CALL :E6ED (0) Get linenr and find it REM * Entry from ON - GOTO: REM RGT10 MOV B,H ) Set textpointer to line MOV C,L ) ORA A No special action RET * *************************** * RUN basiccmd ON .. GOTO * *************************** * RONGT CALL :DF78 Process command JC :DF66 Use GOTO if OK RET If outside list * **************************** * RUN basiccmd ON .. GOSUB * **************************** * RONGS CALL :DF78 Process command JC :DF2D Use GOSUB if OK RET If outside list * *********************** * COMMON 'ON ..' CODE * *********************** * * Exit: CY=1: OK. * CY=0: Outside list. * RONFN CALL :E71D ) (0) Get index of number MOV E,A ) in list in E LDAX B Get nr of linenrs in list INX B MOV L,A MVI H,:00 DAD H DAD B Pointer after list PUSH H Save pointer DCR E INR E JZ :DF9B Index of 0: outside list CMP E JC :DF9B If index too large MVI D,:00 DCX D XCHG DAD H DAD B Pntr to reqd linenr MOV B,H ) in BC MOV C,L ) CALL :E6ED (0) Find reqd line POP B STC CY=1: OK RET REM * If outside list: REM ROF10 POP B ROF11 ORA A CY=0: outside list RET * ******************** * RUN basiccmd RUN * ******************** * * No linenumber is given. * * *********** * RUN RUN * *********** * * The sequence of the instructions is modified. * This enables RUN to be used without * destroying the contents of heap and symtab. * RRUN CALL :CB23 Empty heap and symtab LHLD :029F Get start textbuf MOV B,H ) in BC MOV C,L ) CALL :E401 Run RESTORE LXI H,:0000 SHLD :0115 Reset step/trace flag XRA A STA :0126 No suspended program LXI SP,:F900 Reset SP ORA A No special action JMP :C88F Run program * ***************************** * RUN basiccmd RUN * ***************************** * * After RUN, a line number is given. * RRUNN CALL :E6ED (0) Read linenr and find REM it in textbuf REM * RUN : REM JMP :DFA4 ! Process RUN * ********************* * RUN basiccmd POKE * ********************* * RPOKE CALL :E6F8 (0) Get addr in HL REM * Entry for other modules: REM RPEN CALL :E71D (0) Get argument in A MOV M,A Store it ORA A No special action RET * ******************** * RUN basiccmd OUT * ******************** * ROUT CALL :E71D (0) Get portnr in A MOV D,A and in D CALL :E71D (0) Get data in A MOV E,A and in E ORA A JMP :D8C8 Output to DCE-bus * ********************* * RUN basiccmd WAIT * ********************* * * WAIT I,J,K reads the status of Real World port * I, EXOR's it with K and AND's it with J until * a result equal to J is obtained. * RWAIT CALL :E71D (0) Get portnr MOV D,A in D CALL :E71D (0) Get bits needed high MOV H,A in H LDAX B Get next byte from text INX B SUI :FF Check if only 2 arguments NOP CNZ :CEDA If 3 arg: Get XOR mask MOV L,A in L RWT20 CALL :D8E0 Input from DCE-bus MOV A,E into A XRA L XOR with mask ANA H AND with bits needed high CMP H Correct value reached? RZ Then abort CALL :D6A5 Check keyb for new inputs JNC :DFE6 Next DCE-input if no Break REM * If suspended: REM JMP :E012 (0) Quit: 'cmd broken in' * ************************* * RUN basiccmd WAIT MEM * ************************* * * As WAIT, but with I is a memory location. * RWTEM CALL :E6F8 (0) Get memory addr in HL CALL :E71D (0) Get bit mask MOV D,A in D LDAX B Get next byte from text INX B SUI :FF Check if only 2 arguments NOP CNZ :CEDA If 3 arg: Get XOR mask MOV E,A in E RWM20 MOV A,E XOR mask in A XRA M XOR with memory ANA D AND with bit mask CMP D Correct value reached? RZ Then abort CALL :D6A5 Check keyb for inputs JNC :E007 Cont if no Break pressed REM * If suspended: REM RWT30 MVI A,:02 Code 'command broken in' STC RET * * * UNL RIFG EQU RIFTL LST END